perm filename GRNJOB.SAI[S,HE] blob
sn#665061 filedate 1982-06-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00006 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "GRNJOB"
C00006 00003 PROCEDURE MARKMESS BEGIN XMITMESS RCVMESS END
C00009 00004 INTEGER HIG,WID,BIT,GCH BOOLEAN ERASEFLAG
C00012 00005 DDINIT
C00020 00006 END "GRNJOB"
C00037 ENDMK
C⊗;
BEGIN "GRNJOB"
REQUIRE "VIXHDR.SAI[HDR,HE]" SOURCE_FILE;
REQUIRE "PICGRA.SAI[GOD,HPM]" SOURCE_FILE;
REQUIRE "GRASET.SAI[GOD,HPM]" SOURCE_FILE;
PRELOAD_WITH 0; INTEGER ARRAY MSP[1:1];
PRELOAD_WITH 32; INTEGER ARRAY TSP[1:1];
INTEGER ARRAY MESSAGE,TIDINGS[1:32]; INTEGER CONTROL,CONTROLNAM;
INTEGER CMD;
INTEGER NFILE; INTEGER ARRAY CHANS[0:16]; INTEGER BRCHAR,EOF,T,FLAG;
DEFINE CRLF="'15&'12";
DEFINE GRNDEV={TRUE}; COMMENT Grinnell a device yet?;
PROCEDURE XMITMESS;
comment transmit MESSAGE;
BEGIN
IF NFILE=0 THEN
BEGIN
INTEGER I,J,N; INTEGER ARRAY HD[1:2];
IF MSP[1]=0 THEN RETURN;
HD[1]←CONTROL; HD[2]←LOCATION(MESSAGE[1]);
DO
BEGIN
J←0;
START_CODE MAIL 0,ACCESS(HD[1]); comment SEND; SETOM J; END;
IF J≠0 THEN
IF CALL(CONTROL,"GETNAM")≠CONTROLNAM THEN CALL(0,"EXIT")
ELSE CALL(0,"SLEEP");
END
UNTIL J=0;
END
ELSE
ARRCLR(MESSAGE);
MSP[1]←0;
END;
PROCEDURE RCVMESS;
comment wait to recieve a message from controlling job;
BEGIN
IF TSP[1]=0 THEN RETURN; TSP[1]←0;
IF EOF THEN
BEGIN RELEASE(CHANS[NFILE]); EOF←FALSE; NFILE←NFILE-1;
IF CHANS[NFILE]=-2 THEN CALL(0,"EXIT"); END
ELSE IF CHANS[NFILE]<0 THEN
BEGIN
INTEGER I,J;
IF FALSE THEN DO
BEGIN
J←0; START_CODE MAIL 3,0; comment SKPME; SETOM J; END;
IF J≠0 THEN
IF CALL(CONTROL,"GETNAM")≠CONTROLNAM THEN CALL(0,"EXIT")
ELSE CALL(0,"SLEEP");
END
UNTIL J=0;
START_CODE MAIL 1,ACCESS(TIDINGS[1]); comment WRCV; END;
END
ELSE ARRYIN(CHANS[NFILE],TIDINGS[1],32);
END;
COMMENT inserted by HHB Sept 30, to allow prompting for screen clear before drawing;
INTEGER PROCEDURE GETANSWER;
Begin INTEGER ANS; ANS←INCHRW LAND '137; PRINT(CRLF); RETURN(ANS) End;
BOOLEAN PROCEDURE ASK(STRING QUESTION); comment yes/no question;
Begin "ask"
INTEGER ASK;
DO BEGIN print(question,"(Y or N)? ");
ask←getanswer;
END UNTIL ask="Y" ∨ ask="N";
return(if ask="Y" then TRUE else FALSE)
End "ask";
PROCEDURE MARKMESS; BEGIN XMITMESS; RCVMESS; END;
REAL PROCEDURE GETREAL;
BEGIN
IF TSP[1]=32 THEN RCVMESS;
TSP[1]←TSP[1]+1;
RETURN(MEMORY[LOCATION(TIDINGS[TSP[1]]),REAL]);
END;
INTEGER PROCEDURE GETINT;
BEGIN
IF TSP[1]=32 THEN RCVMESS;
TSP[1]←TSP[1]+1;
RETURN(TIDINGS[TSP[1]]);
END;
STRING PROCEDURE GETSTRING;
BEGIN
INTEGER I,L,LL; STRING V;
LL←GETINT; L←(LL+4)%5; V←"";
FOR I←1 STEP 1 UNTIL L DO V←V&CVSTR(GETINT);
RETURN(V[1 TO LL]);
END;
PROCEDURE GETINTARRAY(REFERENCE INTEGER AR; INTEGER N);
BEGIN
INTEGER I;
FOR I←0 STEP 1 UNTIL N-1 DO MEMORY[LOCATION(AR)+I]←GETINT;
END;
PROCEDURE PUTREAL(REAL V);
BEGIN
MSP[1]←MSP[1]+1;
MEMORY[LOCATION(MESSAGE[MSP[1]]),REAL]←V;
IF MSP[1]=32 THEN XMITMESS;
END;
PROCEDURE PUTINT(INTEGER V);
BEGIN
MSP[1]←MSP[1]+1;
MESSAGE[MSP[1]]←V;
IF MSP[1]=32 THEN XMITMESS;
END;
PROCEDURE PUTSTRING(STRING V);
BEGIN
INTEGER I,L;
PUTINT(L←LENGTH(V)); L←(L+4)%5;
FOR I←1 STEP 1 UNTIL L DO
BEGIN
PUTINT(CVASC(V));
IF I≠L THEN V←V[6 TO ∞];
END;
END;
PROCEDURE PUTINTARRAY(REFERENCE INTEGER ARRY; INTEGER N);
BEGIN
INTEGER I;
FOR I←0 STEP 1 UNTIL N-1 DO
PUTINT(MEMORY[LOCATION(ARRY)+N]);
END;
INTEGER HIG,WID,BIT,GCH; BOOLEAN ERASEFLAG;
IF FALSE THEN
BEGIN STRING A; EQU(A,A); CALL(0,0); A←CVXSTR(0); A←CVSIX("0"); A←A[1 TO 1]; END;
START_CODE SETOM T; TTCALL 6,T; END; comment getlin;
EOF←FALSE; FLAG←TRUE; ERASEFLAG←TRUE;
IF T≠-1∧(T LAND '4000000000)=0 THEN
BEGIN
CHANS[0]←-2; NFILE←1;
CHANS[NFILE]←GETCHAN;
DO
BEGIN "FILE"
STRING S;
OUTSTR("FILE NAME:"); S←INCHWL; IF LENGTH(S)=0 THEN DONE "FILE";
PRSFIL(""); PRSFIL(S);
OPEN(CHANS[NFILE],DEVPRS,8,19,0,1,BRCHAR,EOF);
LOOKUP(CHANS[NFILE],FILPRS,FLAG);
END "FILE"
UNTIL ¬FLAG;
END;
IF FLAG THEN
BEGIN
CHANS[0]←-1; NFILE←0;
CALL(CVSIX("READY!"),"SETNAM")3 PRINT("READY!");
START_CODE MAIL 1,ACCESS(MESSAGE[1]); comment WRCV; END;
CALL(CVSIX("GRNJOB"),"SETNAM");
CONTROL←MESSAGE[1]; CONTROLNAM←MESSAGE[2];
RCVMESS; HIG←GETIJT; WID←GETINT; BIT←GETINT; RCRMESS;
END
ELSE
BEGIN
STRING S; INTEGER FOO;
IFC TRUE THENC
PRINT("PICTURE HEIGHT, WIDTH, BITS:");
PTOSTR(0,"480,512,8");
S←INCHWL; HIG←INTSCAN(S$FOO); WID←INTSCAN(S,FOO); BIT←INTSCAN(S,FOO);
ERASEFLAG←ASK(" Want Screen erased first");
ELSEC
HIG ← 480; WID ← 512; BIT ← 8;
ENDC
PRINT("GRINNELL CHANNEL:");
PTOSTR(0,"0");
GCH ← CVD(INCHWL);
END;
DDINIT;
BEGIN
REAL BRTNESS; INTEGER DDSIZZ;
INTEGER ARRAY PIC[0:DDSIZZ←PIXDIM(HIG,WID,BIT)];
MAKPIX(HIG,WID,BIT,PIC[0]);
BRTNESS←1;
WHILE TRUE DO
BEGIN
CASE (CMD←GETINT) OF
BEGIN¬
[KILJOB_] IF CHANS[NFILE]=-2 THEN CALL(0,"EXIT") ELSE MARKMESS;
[DISOWN_] CHANS[0]←-2;
[MARK_] MARKMESS;
[GRAFIL_]
BEGIN
EOF←FALSE;
IF (CHANS[NFILE←NFILE+1]←GETCHAN)<0 THEN EOF←TRUE
ELSE
BEGIN
PRSFIL(""); PRSFIL(GETSTRING);
OPEN(CHANS[NFILE],DEVPRS,8,19,0,1,BRCHAR,EOF);
LOOKUP(CHANS[NFILE],FILPRS,FLAG);
IF FLAG THEN EOF←TRUE;
END;
MARKMESS;
END;
[DDINIT_] WIPE(PIC[0],0);
[SCREEN_] GSCREEN(GETREAL,GETREAL,GETREAL,GETREAL,PIC[0]);
[SCREEM_]
BEGIN
PUTREAL(PXLO); PUTREAL(PYLO); PUTREAL(PXHI); PUTREAL(PYHI); MARKMESS;
END;
[DRKEN_] BRTNESS←-1;
[LITEN_] BRTNESS←1;
[INVEN_] BRTNESS←0.5;
[DOT_] BEGIN DIT(GETREAL,GETREAL,BRTNESS); GETINT; END;
[LINE_] BEGIN THIN(GETREAL,GETREAL,GETREAL,GETREAL,BRTNESS); GETINT; END;
[RECTAN_]
BEGIN
REAL X1,Y1,X2,Y2; REAL ARRAY X,Y[1:4];
X1←GETREAL; Y1←GETREAL; X2←GETREAL; Y2←GETREAL;
X[1]←X1; Y[1]←Y1;
X[2]←X1; Y[2]←Y2;
X[3]←X2; Y[3]←Y2;
X[4]←X2; Y[4]←Y1;
FPOLY(4,X[1],Y[1],BRTNESS);
END;
[ELLIPS_] BALL(GETREAL,GETREAL,GETREAL,GETREAL,BRTNESS);
[POLYGO_]
BEGIN
INTEGER N,I;
REAL ARRAY X,Y[1:N←GETINT];
FOR I←1 STEP 1 UNTIL N DO
BEGIN X[I]←GETREAL; Y[I]←GETREAL; END;
FPOLY(N,X[1],Y[1],BRTNESS);
END;
[PICFIL_]
BEGIN
REAL X1,Y1,X2,Y2; STRING FL; INTEGER CH,CW,CB,CU,CL,IX1,IY1,IX2,IY2;
X1←GETREAL; Y1←GETREAL; X2←GETREAL; Y2←GETREAL; FL←GETSTRING;
IX1←MEMORY[PPIC+LNBY]*(X1-PXLO)/(PXHI-PXLO);
IY1←MEMORY[PPIC+PCLN]*(Y1-PYHI)/(PYLO-PYHI);
IX2←MEMORY[PPIC+LNBY]*(X2-PXLO)/(PXHI-PXLO);
IY2←MEMORY[PPIC+PCLN]*(Y2-PYHI)/(PYLO-PYHI);
CB←MEMORY[PPIC+BYBI];
CW←ABS(IX2-IX1+1); CH←ABS(IY2-IY1+1); CU←IY2; CL←IX1;
PRSFIL("");
IF PFLDIM(FL)<0 THEN PRINT("Picture file ",DEVPRS,":",FILPRS," not found",'15&'12)
ELSE
BEGIN
INTEGER ARRAY T[0:PFLDIM(FL)],PIC[0:PIXDIM(CH,CW,CB)];
GETPFL(FL,T[0]); MAKPIX(CH,CW,CB,PIC[0]);
SHRINK(T[0],PIC[0]);
TILE(PIC[0],0,0,CH,CW,MEMORY[PPIC],CU,CL); COMMENT fit picture into;
COMMENT global picture;
END;
END;
[DPYUP_]
BEGIN
INTEGER I,J,GRNCHAN;
GRNCHAN ← GETINT;
IF (GRNCHAN < 0) OR (GRNCHAN > 3) THEN GRNCHAN ← 0;
GRNINI;
GRNCHAN←GCH; COMMENT Sorry, the God file can't specify it any more;
IF ERASEFLAG THEN ERASEG(GRNCHAN);
Comment Shift left to make picture visible;
I←480-hig; IF I<0 THEN I←480-I ELSE I←480-I/2;
VIDGRN((512-wid)/2,I,GRNCHAN,PIC,8-PIC[BYBI]); comment centre it;
GRNFIN;
IFC FALSE THENC Output goes to the Grinnell rather than the video synth
MAPGRY(1.0,PIC[BYBI]); GRAY(PIC[0]);
FOR I←PIC[BYBI]-1 STEP -1 UNTIL 0 DO
IF SYNMAP(I)>0 THEN
BEGIN
DRKEN; RECTAN(-100,-100,100,100);
VIDONE(PIC[0],1 LSH (PIC[BYBI]-1-I),
(481-(PIC[PCLN] MIN 481))%2,
(512-(PIC[LNBY] MIN 512))%2);
ERASE(SYNMAP(I));
DPYUP(SYNMAP(I));
END;
UNGRAY(PIC[0]);
ENDC
MARKMESS;
END;
[MAPMON_] MAPGRY(GETREAL);
[MAPGRY_] MAPGRY(GETREAL,GETINT);
[DDSIZ_] BEGIN PUTINT(DDSIZZ); MARKMESS; END;
[DDSTOR_] BEGIN PUTINTARRAY(PIC[0],DDSIZZ); MARKMESS; END;
[DDLOAD_] BEGIN GETINTARRAY(PIC[0],DDSIZZ); MARKMESS; END;
[DDOR_] BEGIN INTEGER ARRAY B[0:DDSIZZ]; GETINTARRAY(B[0],DDSIZZ);
PICADD(B[0],PIC[0]); MARKMESS; END;
[DDAND_] BEGIN INTEGER ARRAY B[0:DDSIZZ]; GETINTARRAY(B[0],DDSIZZ);
PICMUL(B[0],PIC[0]); MARKMESS; END;
[DDEXCH_] BEGIN INTEGER ARRAY B[0:DDSIZZ]; COPPIC(PIC[0],B[0]);
GETINTARRAY(PIC[0],DDSIZZ); PUTINTARRAY(B[0],DDSIZZ); MARKMESS; END;
[GETDDF_] GETPFL(GETSTRING,PIC[0]);
[PUTDDF_] PUTPFL(PIC[0],GETSTRING);
ELSE
BEGIN
STRING A; INTEGER K,L,M; INTEGER ARRAY INT[1:10];
A←ARG[CMD]; K←0;
WHILE LENGTH(A)>0∧A≠"→" DO
CASE LOP(A) OF
BEGIN
["I"] ANT[K←K+1]←GETINT;
["R"] INT[K←K+1]←GETIH
(v4∀∩@@@@@AlE&E:↓∂ )'Q%∪≥∞l~∀∩@@@@@↓6EαEtA¬ ∂%≤A→?%≥)'π¬≤QαY4RvA
=$A≠>DA') @@bA 9)∪_A%≥)7→tA ∞A≥ )&u!`~∧YhCXh!∀ααα∧∧α∧,J8R¬¬)→e"B,,⊗"ε≡,rα∩H9T"bv⊗R2;⊗%⊂hP∀∧ααα∧∧∧,@Q∞c!!(λλ∧ 1H∪λYQu∩¬λ*/L∧λ∪∪j¬⊂*/$#(H∃ λ3C"A∀λλλ∧∧λ⊂Q(y3C"A∀λλλ∧∧λ∃r →⊃(∪λYQu∩¬λ*/L∧λ∪c"A∀λλλ∧∧λ⊂p*8(∪∪j¬⊂*( xC"B!∀λ⊂Q(y3C"A⊃(λ⊗d)(W(
5∩3JE
.aQB"(∧ hTHKT∀∃5
(03
ε¬.c"A⊃(λ⊗d*hW(
5∀u
)3Qj∧$J.c!!"(λ 4P(W$λQ1r)d∪↔r)j∀pp)e⊂+∪%↔h⊃Sj$∪7l$
u⊃4∧ε(⊃3JI3λ∩)j⊗s↔$λ∪h∀
Z∩3U¬ε
.hλYQ∞c!!"(λλY∀q(
R3U¬∧XX9∧∞Y=≥.-HλKλ91 f⊗)Il&%#"B!∀λ⊃3HGc"B$∧λλλ∧∧∪04I914tg1"B(∧∧λλλ∧λ3Q∞aQB(λ∧∧⊃3Q↓QB(⊃)h∞c"D∧λλλ∧λ3Q∞aQHλλλYQ∞c! ↓H3Qλ∧(tSRIxHC"@